home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue48 / Clinic / MonLibU.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-05-26  |  3.0 KB  |  115 lines
  1. unit MonLibU;
  2.  
  3. interface
  4.  
  5. uses
  6.   Classes;
  7.  
  8. //From DB.PAS
  9. type
  10.   TWriteProc = function (Client: TObject; Data: PChar; Len: Integer): LongBool; stdcall;
  11.  
  12. function RegisterClient(Handle: Integer; ClientName: PChar;
  13.   var WriteProc: TWriteProc; Instance: TObject;
  14.   const SignalProc: Pointer): TObject; stdcall;
  15. procedure UpdateClients(TraceValue: Integer); stdcall;
  16. function WriteRoutine(Client: TObject; Data: PChar; Len: Integer): LongBool; stdcall;
  17.  
  18. implementation
  19.  
  20. uses
  21.   Windows, MonHelpU, MonWndU, SysUtils, Dialogs;
  22.  
  23. var
  24.   ClientList: TList = nil;
  25.  
  26. type
  27.   TSignalProc = procedure(Sender: TObject; Data: Integer) of object;
  28.  
  29.   //Object to represent client
  30.   TClient = class
  31.   public
  32.     SignalProc: TSignalProc;
  33.     constructor Create;
  34.     destructor Destroy; override;
  35.   end;
  36.  
  37. constructor TClient.Create;
  38. begin
  39.   inherited;
  40.   //Add object to list
  41.   ClientList.Add(Self)
  42. end;
  43.  
  44. destructor TClient.Destroy;
  45. begin
  46.   //Remove object from list
  47.   ClientList.Delete(ClientList.IndexOf(Self));
  48.   inherited;
  49. end;
  50.  
  51. function RegisterClient(Handle: Integer; ClientName: PChar;
  52.   var WriteProc: TWriteProc; Instance: TObject;
  53.   const SignalProc: Pointer): TObject;
  54. var
  55.   LogStart: String;
  56. begin
  57.   //Can forget about this object once it is set up, as the client app will free it
  58.   Result := TClient.Create;
  59.   //Client's routine to tell about new trace flags
  60.   TMethod(TClient(Result).SignalProc).Data := Instance;
  61.   TMethod(TClient(Result).SignalProc).Code := SignalProc;
  62.   //Inform client of current trace options
  63.   TClient(Result).SignalProc(Result, HelperForm.TraceValue);
  64.   //Tell client app where to send trace messages to
  65.   WriteProc := WriteRoutine;
  66.   //Acknowledge start of log for new client
  67.   LogStart := Format('Log started for %s', [ClientName]);
  68.   WriteRoutine(nil, PChar(LogStart), Length(LogStart))
  69. end;
  70.  
  71. procedure UpdateClients(TraceValue: Integer);
  72. var
  73.   Loop: Integer;
  74. begin
  75.   //When UI has trace option check boxes changed, update all Monitor clients
  76.   for Loop := 0 to ClientList.Count - 1 do
  77.     TClient(ClientList[Loop]).SignalProc(ClientList[Loop], TraceValue)
  78. end;
  79.  
  80. var
  81.   Delphi2ClientLibPath, TraceBuffer: TSharedMem;
  82.  
  83. function WriteRoutine(Client: TObject; Data: PChar; Len: Integer): LongBool; stdcall;
  84. begin
  85.   StrCopy(PChar(TraceBuffer.Buffer), Data);
  86.   if HelperForm.MonitorWnd = 0 then
  87.     Result := False
  88.   else
  89.     Result := SendMessage(HelperForm.MonitorWnd, wm_TraceMessage, 0, 0) <> 0
  90. end;
  91.  
  92. procedure CreateMemoryMappedFiles;
  93. var
  94.   ModuleName: array[0..MAX_PATH] of Char;
  95. begin
  96.   Delphi2ClientLibPath := TSharedMem.Create('SMClientLib', MAX_PATH);
  97.   Move(ModuleName, Delphi2ClientLibPath.Buffer^,
  98.     GetModuleFileName(HInstance, ModuleName, SizeOf(ModuleName)) + 1);
  99.   TraceBuffer := TSharedMem.Create('SMBuffer', TraceBufSize);
  100. end;
  101.  
  102. procedure DeleteMemoryMappedFiles;
  103. begin
  104.   Delphi2ClientLibPath.Free;
  105.   TraceBuffer.Free;
  106. end;
  107.  
  108. initialization
  109.   ClientList := TList.Create;
  110.   CreateMemoryMappedFiles;
  111. finalization
  112.   DeleteMemoryMappedFiles;
  113.   ClientList.Free
  114. end.
  115.